home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / fielddh.exe / FIELDS_C.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-30  |  26KB  |  685 lines
  1. {*************************************************}
  2. {                                                 }
  3. {   Turbo Pascal 6.0                              }
  4. {   Turbo Vision Forms Demo                       }
  5. {   Copyright (c) 1990 by Borland International   }
  6. {*************************************************}
  7. {                                                 }
  8. {  Original by BI, my additions are FREEWARE      }
  9. {          Doug Hood CIS 70324,3336               }
  10. {                                                 }
  11. {*************************************************}
  12. { Original Allows for                             }
  13. {   1: non-blank input lines!                     }
  14. {   2: ranged integer fields!                     }
  15. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  16. {   DWH: added Err_Msg String                     }
  17. {        added COLORS to buttons/static/input text}
  18. {        added NoEcho fields (for passwords)      }
  19. {        added UPPERCASE input lines              }
  20. {        added centered input lines               }
  21. {        added drive input lines                  }
  22. {        added path  input lines                  }
  23. {                                                 }
  24. {*************************************************}
  25.  
  26. unit Fields_Color;
  27.  
  28. {$F+,O+,X+,S-,D-}
  29.  
  30. interface
  31.  
  32. uses Objects, Drivers, Dialogs, Views,
  33.      Color_App;   {color Buttons/Text, dialogs, and field support}
  34.  
  35. type
  36.  
  37. {*************************************************************************}
  38. {*  TInputLine (TVision)                                                 *}
  39. {*        |                                                              *}
  40. {*        + Color_InputLine (in unit COLOR_APP)                          *}
  41. {*                |                                                      *}
  42. {*                + TKeyInputLine (can be invalid if empty)              *}
  43. {*                      |                                                *}
  44. {*                      + TUpper_InputLine                               *}
  45. {*                      |        |                                       *}
  46. {*                      |        + TCentered_InputLine                   *}
  47. {*                      |        |                                       *}
  48. {*                      |        + TPath_InputLine                       *}
  49. {*                      |        |                                       *}
  50. {*                      |        + TDrive_InputLine                      *}
  51. {*                      |        |                                       *}
  52. {*                      |        + TNoEcho_InputLine                     *}
  53. {*                      |        |                                       *}
  54. {*                      |        + TDate_InputLine                       *}
  55. {*                      |                                                *}
  56. {*                      + TNumInputLine                                  *}
  57. {*************************************************************************}
  58.  
  59.  
  60.   {*------------------------------------------------*}
  61.   { Same as Color_InputLine, except invalid if empty }
  62.   {*------------------------------------------------*}
  63.   PKeyInputLine = ^TKeyInputLine;
  64.   TKeyInputLine = object(COLOR_APP.Color_InputLine)
  65.     IsValid : boolean;
  66.     Blank_Is_Allowed : boolean;
  67.     constructor Init(var Bounds: TRect; AMaxLen: Integer;
  68.                      Color_Id           : word;     {0=use default}
  69.                      Empty_Allowed      : boolean);
  70.     function Valid(Command: Word): Boolean; virtual;
  71.     procedure HandleEvent (var Event : TEvent); virtual;
  72.     function GetPalette: PPalette; VIRTUAL; {for change color on error}
  73.   end; {tkeyinputline}
  74.  
  75.  
  76.   {*-------------------------------------------------*}
  77.   { Same as TKeyInputLine, except can force UPPERCASE }
  78.   {*-------------------------------------------------*}
  79.   PUpper_InputLine = ^TUpper_InputLine;
  80.   TUpper_InputLine = object(TKeyInputLine)
  81.     Force_UpperCase : boolean;
  82.     constructor Init(var Bounds: TRect; AMaxLen: Integer;
  83.                      Color_Id           : word;     {0=use default}
  84.                      Empty_Allowed      : boolean;
  85.                      Force_To_Uppercase : boolean);
  86.     procedure HandleEvent (var Event : TEvent); virtual;
  87.   end; {tupper_inputline}
  88.  
  89.  
  90.   {*--------------------------------------------------------------*}
  91.   { Same as TUpper_InputLine, except centers string as its entered }
  92.   {*--------------------------------------------------------------*}
  93.   PCentered_InputLine = ^TCentered_InputLine;
  94.   TCentered_InputLine = object(TUpper_InputLine)
  95.     Left_Justify_Allowed : boolean; {whether to look for ^LJ}
  96.     constructor Init(var Bounds: TRect; AMaxLen: Integer;
  97.                      Color_Id           : word;     {0=use default}
  98.                      Empty_Allowed      : boolean;
  99.                      Force_To_Uppercase : boolean;
  100.                      Allow_Left_Justify : boolean); {^LJ}
  101.     procedure HandleEvent (var Event : TEvent); virtual;
  102.     procedure SetData(var Rec); virtual;
  103.   end; {tcentered_inputline}
  104.  
  105.  
  106.   {*--------------------------------------------------------------*}
  107.   { Same as TUpper_InputLine, except expects full path syntax      }
  108.   { also checks if path exists and warns user if it doesnt         }
  109.   {*--------------------------------------------------------------*}
  110.   PPath_InputLine = ^TPath_InputLine;
  111.   TPath_InputLine = object(TUpper_InputLine)
  112.     function Valid(Command: Word): Boolean; virtual;
  113.   end; {tpath_inputline}
  114.  
  115.  
  116.   {*--------------------------------------------------------------*}
  117.   { Same as TUpper_InputLine, except expects a drive letter        }
  118.   { also checks if drive exists and warns user if it doesnt        }
  119.   {*--------------------------------------------------------------*}
  120.   PDrive_InputLine = ^TDrive_InputLine;
  121.   TDrive_InputLine = object(TUpper_InputLine)
  122.     Bytes_Free_Req : LongInt;
  123.     constructor Init(var Bounds: TRect; AMaxLen: Integer;
  124.                      Color_Id                : word;     {0=use default}
  125.                      Empty_Allowed           : boolean;
  126.                      Force_To_Uppercase      : boolean;
  127.                      Num_Disk_Bytes_Required : LongInt); {0=dont care}
  128.     function Valid(Command: Word): Boolean; virtual;
  129.   end; {tdrive_inputline}
  130.  
  131.  
  132.   {*---------------------------------------------------*}
  133.   { Same as TInputLine, except writes '*' for each char }
  134.   {  [very useful for passwords]                        }
  135.   {*---------------------------------------------------*}
  136.   PNoEcho_InputLine = ^TNoEcho_InputLine;
  137.   TNoEcho_InputLine = object(TUPPER_InputLine)
  138.      procedure Draw; virtual;
  139.   end; {tnoecho_inputline}
  140.  
  141.  
  142.   {*----------------------------------------------------*}
  143.   { Accepts only valid numeric input between Min and Max }
  144.   {*----------------------------------------------------*}
  145.   PNumInputLine = ^TNumInputLine;
  146.   TNumInputLine = object (TKeyInputLine)
  147.     Min: Longint;
  148.     Max: Longint;
  149.     Err_Msg_String : string[80];
  150.     constructor Init(var Bounds: TRect; AMaxLen: Integer;
  151.                      Color_Id           : word;     {0=use default}
  152.                      Empty_Allowed      : boolean;
  153.                      AMin, AMax: Longint;
  154.                      Err_Msg_Start : string);
  155.     constructor Load(var S: TStream);
  156.     function DataSize: Word; virtual;
  157.     procedure GetData(var Rec); virtual;
  158.     procedure SetData(var Rec); virtual;
  159.     procedure Store(var S: TStream);
  160.     function Valid(Command: Word): Boolean; virtual;
  161.   end; {tnuminputline}
  162.  
  163.  
  164.   {*--------------------------------------------------------------*}
  165.   { Same as TUpper_InputLine, except expects date syntax           }
  166.   { also checks if date exists and warns user if it doesnt         }
  167.   {*--------------------------------------------------------------*}
  168.   PDate_InputLine = ^TDate_InputLine;
  169.   TDate_InputLine = object(TUpper_InputLine)
  170.     Month, Day, Year : word;
  171.     function Valid(Command: Word): Boolean; virtual;
  172.     constructor Init (var Bounds: TRect